#!/usr/local/bin/perl -w
use strict;
use warnings;
use utf8;

use EV;
use IO::Socket::INET;

use Getopt::Long;
use JSON::XS;
use HTTP::Parser::XS qw(parse_http_response HEADERS_AS_HASHREF);

use Data::Dumper;

my $interval;
my $login;
my $inter;
my $count = 0;
my $sid;
my $port;
my $addr;
my $host;
my $path;
my $debug;
my $maxcount;
my $check_to;
my $chanel;
my $quiet;

my @options = (
	"interval=i"	=> \$interval,
	"quiet"	        => \$quiet,
	"debug:1"   	=> \$debug,
	"interactive"	=> \$inter,
	"login=s"	    => \$login,
	"port=s"	    => \$port,
	"addr=s"	    => \$addr,
	"host=s"	    => \$host,
	"path=s"	    => \$path,
	"count=i"	    => \$maxcount,
	"timeout=i"	    => \$check_to,
	"chanel=s"		=> \$chanel,
);
get_param();
$addr ||= "127.0.0.1";
$port ||= 12345;
$host ||= "localhost";
$maxcount ||= 1000;
$check_to ||= 60;
$chanel ||= "main";
$debug ||= 0;

my $rid = 1000;
unless($login){
	die "need login";
}
if($path){
	$path .= "/";
}else{
	$path = "";
}

$| = 1;
binmode \*STDOUT,":utf8";


my @global_watcher;
my %watcher;
my $checker_t;
my $checker_w;

if($inter){
	push @global_watcher, EV::io(\*STDIN, EV::READ, \&input_handler);
	push @global_watcher, EV::signal( 'INT', \&signal_handler );
}
if($interval){
	push @global_watcher, EV::timer $interval, $interval, \&interval_handler;
}

send_message(login => {login=>$login},\&login_handler);

EV::loop;
print "\nExit normaly\n";

################################################
sub input_handler {
	my $str = <STDIN>;
	send_message(parse_input($str));
}
sub interval_handler {
	if(++$count < $maxcount){
		send_message(message=>{text =>"my counter $count from $maxcount ".ts(),chanel=>$chanel});
	}else{
		EV::break EV::BREAK_ALL;
	}
}
sub signal_handler {
	print "\nSIGINT, will now quit\n";
	EV::break EV::BREAK_ALL;
}
sub run_checker {
	$checker_t = EV::timer 1, $check_to, \&checker_handler;
}
sub checker_handler {
	if($checker_w){
		delete $watcher{int $checker_w};
		$checker_w->stop;
		$checker_w = undef;
	}
	print ts()," resend checker\n" if $debug;
	call_checker();
}
sub call_checker {
	send_message(check=>{},\&call_checker,\&store_checker_reader);
	$checker_t->again;
}
sub store_checker_reader {
	my ($w) = $_;
	$checker_w = $w;
}
sub login_handler {
	my $msg = shift;
	unless($msg->{error}){
		$sid = $msg->{sid};
		run_checker();
		send_message(create=>{chanel=>$chanel},sub {
			send_message(join=>{chanel=>$chanel});
		});
	}else{
		print "Cannot login '$msg->{error}' '$msg->{text}'\n";
		EV::break EV::BREAK_ALL;
	}
}
sub send_message {
	my ($command,$message,$callback,$before_read) = @_;

	my $start = time();

	my $socket = IO::Socket::INET->new(
				PeerHost => $addr,
				PeerPort => $port,
				Type     => SOCK_STREAM,
			);
	unless($socket){
		print "Cannot construct socket - $@\n";
		exit;
	}

	my $end = time();
	long_connection($start,$end);
	
	$message->{ts} = ts();
	$message->{rid} = $rid++;
	$message->{sid} = $sid if $sid;
	$message->{chanel} ||= $chanel;

	my $body = encode_json($message);

	my $to_send = sprintf(
"POST /%s$command HTTP/1.1
Content-Length: %d
Host: %s
Connection: close

%s",
		$path,length($body),$host,$body);
	print "SEND:\n",$to_send,"\n" if $debug > 1;
	my $w = EV::io $socket, EV::WRITE,\&send_handler;
	$watcher{int $w} = [$w,$socket,$to_send,$callback,$before_read];
	return $w;
}
sub send_handler {
	my ($w,$m) = @_;
	my $ary = $watcher{int $w};
	unless($ary){
		print "Empty watcher:",int($w),"\n";
		exit;
	}
	my $need = length($ary->[2]);
	my $rs;
	eval {
		$rs = $ary->[1]->send($ary->[2]);
	};
	if($@){
		print "ERROR: $@\n";
		print $ary->[2],"\n";
		print "type: $ary->[3]\n";
		exit;
	}
	if($rs){
		$need -= $rs;
		# если отправлено не все, то продолжаем ждать
		if($need > 0){
			substr($ary->[2],0,$rs,"");
			return 0;
		}
	}
	delete $watcher{int $w};
	my $data = $w->data;
	$w = EV::io $ary->[1], EV::READ, \&read_handler;
	$watcher{int $w} = [$w,$ary->[1],"",$ary->[3]];
	if($ary->[4]){
		$ary->[4]->($w);
	}
}
sub read_handler {
	my ($w,$m) = @_;
	my $ary = $watcher{int $w};
	my $buf;
	$ary->[1]->recv($buf,1024);
	if($buf){
		if(my $msg = parse_response($ary->[2] .= $buf)){
			process_response($msg);
			if($ary->[3]){
				$ary->[3]->($msg);
			}
		}else{
			return 0;
		}
	}
	# раобота с содинением закончена, закрываем и чистим
	delete $watcher{int $w};
}
sub parse_response{
	my $full_body = shift;
	my($ret, $mv, $status, $mss, $headers) = parse_http_response($full_body, HEADERS_AS_HASHREF);
	if($ret > 0) {
		if($status == 200){
			my $body = substr($full_body,$ret);
			if($headers->{'content-length'} && $headers->{'content-length'} > length($body)){
				return 0;
			}else{
				print "RECV:\n",$full_body,"\n" if $debug > 1;
				my $msg;
				eval {
					$msg = decode_json($body);
				};
				if($@){
					print "Broke json: $!\n";
					exit;
				}
				return $msg;
			}
		}else{
			print "BAD RESPONSE: ",$status," ",$mss,". Exited.\n";
			exit;
		}
	}elsif($ret == -2){
		print "Broken response. Exited.\n";
		exit;
	}else{
		return 0;
	}
}
sub process_response {
	my $msg = shift;
	if($msg->{type} eq "response"){
		if($msg->{error}){
			print "$msg->{ts} RESPONSE($msg->{command}:$msg->{rid}): error($msg->{error}): ",$msg->{text},"\n" if $debug;
		}else{
			print "$msg->{ts} RESPONSE($msg->{command}:$msg->{rid}): ",$msg->{text},"\n" if $msg->{text} && $debug;
		}
	}elsif($msg->{type} eq "list"){
		print "LISTSIZE=",scalar(@{$msg->{list}})," rid=$msg->{rid}\n" if $debug;
		for(sort {$a->{ats} <=> $b->{ats}} @{$msg->{list}}){
			my $str = $_->{text};
			utf8::decode $str;
			print "<",($_->{chanel}||""),"> ",$_->{ts}," [",($_->{from}||""),":$_->{rid}] ",$str,"\n" unless $quiet;
		}
	}
}
sub parse_input{
	my $str = shift;
	chomp $str;
	my $cmd = "message";
	my $msg = {};
	if($str =~ /^\s*private\s*\[([^\]]*)\]/){
		$msg->{text} = $str;
		if(my @list = grep {$_} map {s/^\s+//;s/\s+$//;$_} split /,/, $1){
			push @list,$login;
			$msg->{to} = \@list;
			$cmd = "private";
		}
	}elsif($str =~ /^\s*chanel\s+(create|remove|join|leave|list)\s+(\w+)/){
		$cmd = $1;
		$msg->{chanel} = $2;
	}elsif($str =~ s/^\s*!(\w+)//){
		$msg->{chanel} = $1;
		$msg->{text} = $str;
	}else{
		$msg->{text} = $str;
	}
	return ($cmd,$msg);
}
sub long_connection {
	my ($start,$end) = @_;
	if($debug){
		my $lc;
		if($end - $start > 30){
			$lc = ("*" x 40)."Super Very Long connect ".($end - $start)." ".("*" x 25)."\n";
		}
		elsif($end - $start > 10){
			$lc = ("*" x 30)."Very Long connect ".($end - $start)." ".("*" x 25)."\n";
		}
		elsif($end - $start > 2){
			$lc = ("*" x 20)."Long connect ".($end - $start)." ".("*" x 25)."\n";
		}
		if($lc){
			print $lc;
		}
	}
}
sub ts {
	return sprintf "%02d:%02d:%02d", (localtime)[2,1,0];
}
sub get_param {
	local $SIG{__WARN__} = sub {die "GETOPT: ".join("\n",@_)};
	GetOptions(@options) or die "$!";
}
